#Logtrack-ng - Module for validating configuration
#Copyright (C) 2007 Jan Kucera
#
#This program is free software; you can redistribute it and/or
#modify it under the terms of the GNU General Public License
#as published by the Free Software Foundation; either version 2
#of the License, or (at your option) any later version.
#
#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with this program; if not, write to the Free Software
#Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

=head1 NAME

Logtrack::Validator;

=head1 DESCRIPTION

Modul se stara o nacteni parametru programu a naslednou validaci konfiguracnich
souboru a vytvoreni odpovidajici struktury pro uziti programem.

=head2 FUNCTIONS
=over 4

=item get_arguments
=item validate_configs
=item failed_xml
=item validate_file
=item fix_arrays
=item open_db
=cut
package Logtrack::Validator;

use strict;
no strict 'refs';
no strict 'subs';

use Exporter;
use Logtrack::Debug;
use Getopt::Long;
use XML::Checker::Parser;
use XML::TreePP;
use Logtrack::Debug;
use Data::Dumper;
use DBI;
use Regexp::Common qw /comment RE_comment_HTML/;
use Module::Runtime qw /use_module /;
use IO::File;

$Data::Dumper::Indent = 1;

use constant TRUE => 1;
use constant FALSE => 0;

sub fix_arrays($$$);


sub new {
	my $self = shift;
	

	my $config = {
		debug => Logtrack::Debug->new()
	};
	my $class = ref $self || $self;
	bless ($config, $class);
	return $config;
}

sub validate {
	my ($self) = @_;
	$self->get_arguments();
	$self->validate_configs()
		if(not $self->{data}{reload});
	return $self->{data};
}

sub errstr {
	my ($self,$message) = @_;
	$self->{debug}->errstr($message);
}

sub errstrln {
	my ($self,$message) = @_;
	$self->{debug}->errstrln($message);
}

sub debug {
	my ($self,$message,$level) = @_;
	$self->{debug}->debug($message,$level);
}

sub debugln {
	my ($self,$message,$level) = @_;
	$self->{debug}->debugln($message,$level);
}

sub DESTROY {
	my $self = shift;
	$self->{debug} = undef;
	my $ref_db = $self->{db};
	$$ref_db->disconnect if(defined $ref_db);
}

=item
Funkce zobrazi napovedu na svuj standartni vystup
=cut

sub print_usage () {
	print <<EOF;
logtrack-ng: program for parsing multiple logfiles
--------------------------------------------------
Usage:
	logtrack-ng [--config|-c <name>] [OPTIONS]
Options: [--test-config|-t] [--help] 
	 [--version] [-v|--verbose] [-reload|-r] [--no-daemon]
EOF
}


=item 
Funkce nacte vstupni parametry a nastavi zakladni atributy potrebne pro budouci
validaci konfigurace.Pokud je jednim z parametru -r|--reload nacita funkce
 konfiguraci z databaze.

Function load input params and set basic configuration needed for later 
validating. If param. -r|--reload is set, program loads all settings from DB
=cut

sub get_arguments {
	my $self = shift;
	my $debug_lvl_one = '';
	my $debug_lvl_two = '';
	my $debug_lvl_three = '';
	$self->{data}{version} = '0.9.5';
	$self->{data}{config_file} = '';
	$self->{data}{reload} = '';
	$self->{data}{nodaemon} = '';

	my ($version,$help);
	
	GetOptions (
		"v|verbose" => \$debug_lvl_one,"vv" => \$debug_lvl_two,
		"vvv" => \$debug_lvl_three,
		"version" => \$version,"config|c=s" => \$self->{data}{config_file},
		"help" => \$help,"reload|r" => \$self->{data}{reload},
		"test-config|t" => \$self->{data}{test},
		"no-daemon" => \$self->{data}{nodaemon}
	);
	
	my @args = (' -c '. $ENV{PWD}. '/' .$self->{data}{config_file});
	
	if($debug_lvl_one) {
		$self->{debug}->set_debug_level(1);
		push (@args,' -v');
	}
	elsif($debug_lvl_two) {
		$self->{debug}->set_debug_level(2);
		push (@args,' -vv');
	}
	elsif($debug_lvl_three) {
		$self->{debug}->set_debug_level(3);
		push (@args,' -vvv');
	}
	else {
		$self->{debug}->set_debug_level(0);
	}
	
	if( ($help) ) {
		print_usage();
		exit(0); 
	}
	
	if( $version ) {
		print 'FiWatch: '. $self->{data}{version} ."\n";
		exit(0);
	}

	push (@args,' --nodaemon') if $self->{data}{nodaemon};
	$self->{data}{args} = \@args;
}

=item
Function first checks base configuration for existence and validate it through
validate_file function. Later it test rest of configuration and store variables
as reference $self->{data}{logs}. If any of those tests fail, program is 
terminated. Last thing in validating is setting duration in tables and 
incidents (default values is 1 hour).

Funckce nejprve provede validaci zakladniho konfiguracniho souboru a nasledne
podrobi zkousce i ostatni soubory prostrednictvim funkce validate_file. Pokud 
jakakoli z techto zkousek neuspeje, je program ukoncen. V opacnem pripade je
konfigurace prevedena do poli a hashu ulozena do $self->{data}{logs}. Posledni 
upravou je validace casu u rotace logu.
=cut

sub validate_configs {
	my ($self) = @_;
	my ($cfg,$log,$tmp,$ref_db);
	
	#Validation basic config file
	if( defined $self->{data}{config_file} && -e $self->{data}{config_file}) {
		$self->debugln('Validating base config file'. "\n" .'-' x 22,1);
		
		my $lg = $self->validate_file($self->{data}{config_file});
		$cfg = $lg->{log}; 		#Cropping object - remain only useful variables
		foreach my $key (keys %{$lg->{global}}) {
			next if($key eq 'log');
			$self->{data}{$key} = $lg->{global}->{$key};
		}
	}
	else { 
		$self->errstrln('Base config file is missing!!');
		$self->errstrln('Please set right path.');
		print_usage(); #Showing help;
		exit(4); 
	}

	my $basedir = $ENV{PWD} .'/';
	my $LOGTYPES = $basedir .'conf/logtypes/';
	my $FILTERS = $basedir .'conf/filters/';
	my $ACTIONS = $basedir .'conf/actions/';
	my $EXCETIONS = $basedir .'conf/exceptions/';

	$ref_db = $self->open_db();
	
	if($self->{data}{refresh} eq '' || not ($self->{data}{refresh} =~ /^\d+$/) 
		|| $self->{data}{refresh} < 0 ) {
		$self->{data}{refresh} = 1;
	}
	
	my @Logs = []; 
	for(my $index=0; $index < @{$cfg}; $index++) {
		$Logs[$index] = {'local_filters' => '','global_filters' => '',
					'exceptions' => '', 'actions' => '', 'logtype' => '',
					'file' => '', 'socket' => ''
		};
	
		#Checks existence of file
		if(exists $cfg->[$index]->{file} && -e $cfg->[$index]->{file}) {
			$Logs[$index]->{file} = $cfg->[$index]->{file};
		}
		#Source of messages is a socket
		elsif(exists $cfg->[$index]->{socket}) {
			$Logs[$index]->{socket} = $cfg->[$index]->{socket};
		}
		else {
			die 'Logfile '.  $cfg->[$index]->{file} .'doesn\'t exist!!'."\n";
		}
	
		my $filters = $FILTERS . $cfg->[$index]->{filters} 
			if($cfg->[$index]->{filters} ne '' &&
				-e $FILTERS . $cfg->[$index]->{filters});
					
		my $exceptions = $EXCETIONS . $cfg->[$index]->{exceptions}
			if($cfg->[$index]->{exceptions} ne '' && 
				-e $EXCETIONS . $cfg->[$index]->{exceptions});
					
		my $actions = $ACTIONS . $cfg->[$index]->{actions}
			if($cfg->[$index]->{actions} ne '' &&
				-e $ACTIONS . $cfg->[$index]->{actions});
			
		my $tmp = $self->validate_file($LOGTYPES . $cfg->[$index]->{logtype});
		$Logs[$index]->{logtype} = $tmp->{part};
		$Logs[$index]->{keys} = undef;

		for(my $part = 0; $part < @{$Logs[$index]->{logtype}}; $part++) {
			$Logs[$index]->{logtype}->[$part]->{id} = "$index.$part";
			next if(not exists $Logs[$index]->{logtype}->[$part]->{key} );
			if($Logs[$index]->{logtype}->[$part]->{key} =~ /#key/) {
				$Logs[$index]->{keys} .= $part. '|';
			}
		}

		if($exceptions) {
			my $tmp = $self->validate_file($exceptions) ;
			$Logs[$index]->{exceptions} = $tmp->{part};
			foreach my $exeption ( @{$Logs[$index]->{exceptions}} ) {
				use_module($exeption->{module});
			}
		}

		if($actions) {
			my $tmp = $self->validate_file($actions) ;
			$Logs[$index]->{actions} = $tmp->{part};
			foreach my $action_list ( @{$Logs[$index]->{actions}} ) {
				foreach my $action ( @{ $action_list->{action} } ) {
					use_module($action->{module});
				}
			}
		}

		if ($filters) {
			my $tmp = $self->validate_file($filters);
			$Logs[$index]->{global_filters} = $tmp->{global_filter};
			$Logs[$index]->{local_filters} = $tmp->{local_filter}->{part};
		}

		# Zjisteni starnuti zprav u vsech zdroju
		if(exists $cfg->[$index]->{rotate_time} && 
				$cfg->[$index]->{rotate_time} ne '') {
			my $result = $$ref_db->selectrow_hashref('
				SELECT EXTRACT (EPOCH FROM INTERVAL \''. 
					$cfg->[$index]->{rotate_time} .'\')'
			);
			
			if(defined $result) {
				$Logs[$index]->{rotate_time} = $cfg->[$index]->{rotate_time};
				$Logs[$index]->{duration} = $result->{date_part};
			}
			else {
				$Logs[$index]->{rotate_time} = '1h';
				$Logs[$index]->{duration} = 3600;
			}
		}
		else {
			$Logs[$index]->{rotate_time} = '1h';
			$Logs[$index]->{duration} = 3600;
		}

		$Logs[$index]->{id} = $index;
	}

	$$ref_db->disconnect;
	$self->{data}{logs} = \@Logs;
	return;
}

=item 
Function takes care of writing problems with XML parsing.
More info:
http://search.cpan.org/~enno/libxml-enno-1.02/lib/XML/Checker/Parser.pm
http://search.cpan.org/~tjmather/XML-Checker-0.13/lib/XML/Checker.pm

=cut

sub failed_xml {
	my $code = shift;
	die XML::Checker::error_string ($code, @_) if $code < 200;
	XML::Checker::print_error ($code, @_);
}

=item
Function validates XML file with existing DTD and then it converts data to
structure. Sequentially is called fix_arrays function for repairing structure
 - this situation exist when XML expect multiple attributes and user defined
only one -> parser transform data to hash, but program accepts only arrays.

Funkce nejprve validuje danou xml konfiguraci podle dtd a nasledne prevede
do struktury. Pote je funkce vola fix_arrays - ktera ma opravit pripadne
chyby ve strukture. Ty vznikaji v pripade, kdyz XML stavene pro vicenasobny 
atribut dostane pouze jediny zaznam - Parser tak vytvori pouze hash, ale 
program bude akceptovat pouze pole.
=cut

sub validate_file {
	my ($self,$file) = @_;
	my $xml_content;
	

		open(XML,$file) or die 'Can\'t open file '. $file ."\n";
	while (<XML>) { 				# Whole XML is loaded to variable
		$xml_content .= $_;
	}

	#All comments are erased
	$xml_content =~ s/$RE{comment}{HTML}{-keep}//g;

	# XML validation through DTD	
	XML::Checker::Parser::map_uri ();
	my $xml_parser = new XML::Checker::Parser ( Handlers => { } );
	eval {
		local $XML::Checker::FAIL = \&failed_xml;
		$xml_parser->parse($xml_content); 
	};

# 	Errors occured, program is terminated
	if ($@) {
		$self->errstrln('Validation of '. $file .' wasn\'t successful!!!');
		die "$@";
	}
	$self->debugln('Validation of '. $file .' was successful.',1);

	return $self->transform_to_hash($file);

}


=item
Function gets path of configuration file and transform XML structure to hashu
and array form thanks to module XML::TreePP. Then it reads files DTD and 
transform every wrong hash	structure to one-item array through fix_arrays
 function

Funkce prebira cestu k XML souboru a prevede jej na strukturu poli a hashu 
prostrednictvim modulu XML::TreePP. Nasledne precte DTD prislusneho souboru
a opravi vsechny chybne struktury hashu na jednoprvkove pole funkci fix_arrays
=cut
sub transform_to_hash {
	my ($self,$file) = @_;
	my ($msg,$parent,$to_fix,$root,$dtd,$xml,$xml_doc,,$dtd_content);

	$xml_doc = XML::TreePP->new();
	$xml_doc->set(attr_prefix => '');
	$xml_doc->set( text_node_key => 'text' );
	$xml = $xml_doc->parsefile($file);
	

	open(XML,$file);
	my $xml_content;
	while(<XML>) {
		$xml_content .= $_;
		$xml_content =~ s/$RE{comment}{HTML}{-keep}//;
		if($xml_content =~ /!DOCTYPE\s*(\w+)\s*SYSTEM\s*"(file:|)(.*\.dtd)"/) {
			$root = $1; $dtd = $3; last;
		}
	}
	close(XML);


	
	if(not defined $root || not defined $dtd) {
		$self->errstrln('Config XML file'. $file 
					.' doesn\'t include DOCTYPE with avaible DTD');
		exit(5);
	}

# 	DTD is stored to temporary variable and all comments are erased
	open(DTD,$dtd);
	while (<DTD>) {
		$dtd_content .= $_;
	}
	close(DTD);
	$dtd_content =~ s/$RE{comment}{HTML}{-keep}//g;

# Every element is searched for multiple arguments and info is stored
	while($dtd_content =~ s/<(!ELEMENT\s+(\w+).*?)>//) {
		$parent = $2;
		my $element = $1;
		if(my @words = ($element =~ /(\w+)[\+\*]/g)) {
			if(@words > 1) {
				$to_fix->{$parent} = \@words;
			}
			else {
				$to_fix->{$parent} = $words[0];
			}
		}
	}

	fix_arrays(\$xml->{$root},$to_fix,$root);
	return $xml->{$root};
}


=item
Function takes care of fixing "bugs" in config structure. If XML attribute 
is expected as multiple, but user defined only one attribute, than Parser
creates structure as a hash, which program doesn't accept. Function receives
struture to fix, root name of XML and hash with attributes which may 
contain "bug". Function works with recursion - it calls itself to every 
component which should be converted as array.
=cut

=item
Funkce se stara o "opraveni" vyjimek konfiguracni struktury. Pokud je struktura
primarne urcena jako viceprvkova, ale konf. soubor obsahuje jen jeden prvek
struktura je utvorena jako hash, coz by zpusobovalo chyby.
Funkce dostava strukturu samotnou, strukturu s podezrelymi misty a korenovy 
prvek. Funkce pak rekurzivne vola sebe sama na vsechny prvky struktury a 
opravuje vsechny "oznacene" hashe, ktere by mely byt podle nastaveni pole
=cut
sub fix_arrays($$$) {
	my ($xml,$to_fix,$root) = @_;
	my ($skip,$tmp);
	if(ref $$xml eq 'HASH') {
		my @keys = keys %{$$xml};	
		foreach my $key (@keys) {
			last if($root eq '');
			next if($key eq '');

			#Determines if struture has multiple attributes
			if(not defined $to_fix->{$root}) {
				fix_arrays(\$$xml->{$key},$to_fix,$key);
				next;
			}
			
			if(ref $to_fix->{$root} eq 'ARRAY') {
				$skip = TRUE;
				foreach my $fix ( @{$to_fix->{$root}} ) {
					if($key eq $fix) {
						$skip = FALSE;
						last;
					}
				}
				next if($skip);
			}
			else {
				next if($key ne $to_fix->{$root}); 
			}
			

			#Struture is suspected that has hash structure instead of array
			if(ref($$xml->{$key}) eq 'HASH') {
				$tmp = $$xml->{$key};
				$$xml->{$key} = [];
				$$xml->{$key}->[0] = $tmp;
				fix_arrays(\$$xml->{$key}->[0],$to_fix,$key);
			}
			elsif(not ref $$xml->{$key}) {
				$tmp = $$xml->{$key};
				$$xml->{$key} = [];
				$$xml->{$key}->[0] = $tmp;
			}
			else {
				fix_arrays(\$$xml->{$key},$to_fix,$key);	
			}
		}
	}
	elsif(ref $$xml eq 'ARRAY') {
		for(my $index=0; $index < @{$$xml}; $index++) {
			fix_arrays(\$$xml->[$index],$to_fix,$root);
		}
	}
}

=item
Function opens connection with DB and returns actual DB structure
=cut

=item
Funkce otevre spojeni s databazi a vraci ukazatel na danou db strukturu
=cut

sub open_db {
	my ($self) = @_;
	my $db;
	if(not $db = DBI->connect('dbi:Pg:dbname=logtrack',
								'postgres', '', {AutoCommit => 0})) {
		$self->errstrln('Can\'t connect to DB');
		exit(1);
	}
	return \$db;
}

1;
